home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2002 November / CD 1 / APC0211D1.ISO / workshop / prog / files / ActivePerl-5.6.1.633-MSWin32.msi / _216da8d9144412e92834516ec1582f77 < prev    next >
Encoding:
Text File  |  2002-05-30  |  3.1 KB  |  70 lines
  1.  
  2.  
  3. sub mkTextBind {
  4.  
  5.     # Create a top-level window that illustrates how you can bind Perl commands to regions of text in a text widget.
  6.  
  7.     $mkTextBind->destroy if Exists($mkTextBind);
  8.     $mkTextBind = $top->Toplevel();
  9.     my $w = $mkTextBind;
  10.     dpos $w;
  11.     $w->title('Text Demonstration - Tag Bindings');
  12.     $w->iconname('Text Bindings');
  13.     my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]);
  14.     my $w_t = $w->Text(-setgrid => 'true', -width => '60', -height => '28',
  15.             -font => '-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*');
  16.     my $w_s = $w->Scrollbar(-command => ['yview', $w_t]);
  17.     $w_t->configure(-yscrollcommand => ['set', $w_s]);
  18.     $w_ok->pack(-side => 'bottom');
  19.     $w_s->pack(-side => 'right', -fill => 'y');
  20.     $w_t->pack(-expand => 'yes', -fill => 'both');
  21.  
  22.     # Set up display styles
  23.  
  24.     my(@bold, @normal, $tags);
  25.     if ($mkTextBind->depth > 1) {
  26.     @bold = (-foreground => 'red');
  27.     @normal = (-foreground => undef);
  28.     } else {
  29.     @bold = (-foreground => 'white', -background => 'black');
  30.     @normal = (-foreground => undef, -background => undef);
  31.     }
  32.  
  33.     $w_t->insert('0.0', 'The same tag mechanism that controls display styles in text
  34. widgets can also be used to associate Perl commands with regions
  35. of text, so that mouse or keyboard actions on the text cause
  36. particular Perl commands to be invoked.  For example, in the
  37. text below the descriptions of the canvas demonstrations have
  38. been tagged.  When you move the mouse over a demo description
  39. the description lights up, and when you press button 3 over a
  40. description then that particular demonstration is invoked.
  41.  
  42. This demo package contains a number of demonstrations of Tk\'s
  43. canvas widgets.  Here are brief descriptions of some of the
  44. demonstrations that are available:');
  45.     insert_with_tags($w_t, "\n\n1. Samples of all the different types of items that can be\ncreated in canvas widgets.", 'd1');
  46.     insert_with_tags($w_t, "\n\n2. A simple two-dimensional plot that allows you to adjust\n", 'd2');
  47.     insert_with_tags($w_t, 'the positions of the data points.', 'd2');
  48.     insert_with_tags($w_t, "\n\n3. Anchoring and justification modes for text items.", 'd3');
  49.     insert_with_tags($w_t, "\n\n4. An editor for arrow-head shapes for line items.", 'd4');
  50.     insert_with_tags($w_t, "\n\n5. A ruler with facilities for editing tab stops.", 'd5');
  51.     insert_with_tags($w_t, "\n\n6. A grid that demonstrates how canvases can be scrolled.", 'd6');
  52.  
  53.     foreach $tag (qw(d1 d2 d3 d4 d5 d6)) {
  54.     $w_t->tag('bind', $tag, '<Any-Enter>' => [sub {shift->tag('configure', shift, @_)}, $tag, @bold]);
  55.     $w_t->tag('bind', $tag, '<Any-Leave>' => [sub {shift->tag('configure', shift, @_)}, $tag, @normal]);
  56.     }
  57.     $w_t->tag('bind', 'd1', '<3>', \&mkItems);
  58.     $w_t->tag('bind', 'd2', '<3>', \&mkPlot);
  59.     $w_t->tag('bind', 'd3', '<3>', \&mkCanvText);
  60.     $w_t->tag('bind', 'd4', '<3>', \&mkArrow);
  61.     $w_t->tag('bind', 'd5', '<3>', \&mkRuler);
  62.     $w_t->tag('bind', 'd6', '<3>', \&mkScroll);
  63.  
  64.     $w_t->mark('set', 'insert', '0.0');
  65.  
  66. } # end mkTextBind
  67.  
  68.  
  69. 1;
  70.